home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_FileRunner.idb / usr / freeware / lib / FileRunner2.5 / font.tcl.z / font.tcl
Encoding:
Text File  |  1999-01-26  |  702 b   |  38 lines
  1.  
  2.  
  3. proc tk_setFont { font } {
  4.     global tkFont
  5.  
  6.     set new(font) $font
  7.  
  8.     if ![info exists tkFont] {
  9.     label .c14732
  10.     set tkFont(font) \
  11.         [lindex [.c14732 configure -font] 3]
  12.     destroy .c14732
  13.     }
  14.     tkFontTree . new
  15.  
  16.     foreach option [array names new] {
  17.     option add *$option $new($option) widgetDefault
  18.     }
  19.     array set tkFont [array get new]
  20. }
  21.  
  22. proc tkFontTree {w font} {
  23.     global tkFont
  24.     upvar $font c
  25.     foreach dbOption [array names c] {
  26.     set option -[string tolower $dbOption]
  27.     if ![catch {$w cget $option} value] {
  28.         if {$value == $tkFont($dbOption)} {
  29.         $w configure $option $c($dbOption)
  30.         }
  31.     }
  32.     }
  33.     foreach child [winfo children $w] {
  34.     tkFontTree $child c
  35.     }
  36. }
  37.  
  38.